perm filename SYSTEM.LSP[1,JRA] blob
sn#011362 filedate 1972-11-08 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 changes that must be made by hand to the CNVR code:
00004 00003 (SETQ DEBUGLOOP NIL)
00006 00004 (DF DO (L)
00008 00005 (PUTPROP @LIST# (GET @LIST @FSUBR) @FSUBR)
00010 00006 (DEFPROP AND (LAMBDA ($L)
00013 00007
00015 ENDMK
⊗;
COMMENT changes that must be made by hand to the CNVR code:
FILE FCN PROBLEM
DB DATA-INIT (ARRAY FRAMES NIL---
in stanford lisp the nil means real number array---
in mac lisp it means don't protect from gc---
change to (ARRAY FRAMES T---
anytime a file is SOSed, it gets CRs added to LFs---look for (QUOTE //) as an
indication of this condition---delete the second / and the )
To convert a MACLISP file to STANFORD LISP do:
R LISP 30<RETURN>
(DSKIN (UTIL.LAP))<RETURN>
(CONVERT)<RETURN>
then, answer the file naming questions-
if the extension for the file is TMP, then the conversion routine
assumes the macro conversion has already been done and starts
with the LAMBDA conversion-
;
(SETQ DEBUGLOOP NIL)
(*RSET T)
(DM TRACE (L)
(PROG2 (DSKIN TRACE)(LIST (QUOTE QUOTE) (EVAL L))))
(PUTPROP @DIFFERENCE (GET @*DIF @SUBR) @SUBR)
(PUTPROP @SASSQ (GET @SASSOC @SUBR) @SUBR)
(PUTPROP @MAPC# (GET @MAPC @SUBR) @SUBR)
(PUTPROP @MAPCAR# (GET @MAPCAR @SUBR) @SUBR)
(PUTPROP @ASSQ (GET @ASSOC @SUBR) @SUBR)
(PUTPROP @APPLY# (GET @APPLY @LSUBR) @LSUBR)
(DF DECLARE (L) (APPEND @(DECLARE) L))
(DECLARE (*FEXPR SSTATUS DECLARE GENPREFIX ))
(DECLARE (*EXPR SPRINT))
(SETQ PURE NIL)
(SETQ ERRLIST NIL)
(SETQ EAR 0)
(SETQ FRAMEVARS NIL)
(SETQ CINTERRUPT NIL)
(SETQ EXP NIL)
(SETQ ALINK NIL)
(SETQ FRAME* NIL)
(SETQ BVARS NIL)
(SETQ CLINK NIL)
(SETQ *ITEMS NIL)
(SETQ NUMACT 0.)
(DF PAGEBPORG (L) @PAGEBPORG)
(DF GENPREFIX (L) @GENPREFIX)
(DF DO (L)
(PROG ($X $XI $XS $ET $BD)
(*SQ $X (CAR L))
(*SQ $XI (CADR L))
(*SQ $XS (CADDR L))
(*SQ $ET (CADDDR L))
(*SQ $BD (CDDDDR L))
START
(SET $X $XI)
DOLOOP
(COND ((EVAL $ET)(RETURN NIL)))
(MAPC @EVAL $BD)
(SET $X (EVAL $XS))
(GO DOLOOP) ))
(DE DELETE $N
((LABEL #DEL (LAMBDA ($X $L $T)
(COND ((NULL $L) NIL)
((EQUAL $X (CAR $L))
(COND ((EQUAL $T 1)(CDR $L))
(T (#DEL $X (CDR $L) (SUB1 $T)))) )
(T (CONS (CAR $L)(#DEL $X (CDR $L) $T))))))
(ARG 1)
(ARG 2)
(OR (AND (= $N 3)(ARG 3))
1) ))
(DE DELQ $N
((LABEL #DEL (LAMBDA ($X $L $T)
(COND ((NULL $L) NIL)
((EQ $X (CAR $L))
(COND ((EQUAL $T 1)(CDR $L))
(T (#DEL $X (CDR $L) (SUB1 $T)))) )
(T (CONS (CAR $L)(#DEL $X (CDR $L) $T))))))
(ARG 1)
(ARG 2)
(OR (AND (= $N 3)(ARG 3))
1) ))
(PUTPROP @LIST# (GET @LIST @FSUBR) @FSUBR)
(DEFPROP LIST
(LAMBDA $N
((LABEL LIST1 (LAMBDA ($X)
(COND ((EQUAL $X (ADD1 $N)) NIL)
(T (CONS (ARG $X)(LIST1 (ADD1 $X)))))))
1))
EXPR)
(REMPROP @LIST @FSUBR)
(DE ASSOC ($A $L)
(COND ((NULL $L) NIL)
((EQUAL $A (CAAR $L))(CAR $L))
(T (ASSOC $A (CDR $L)))))
(DEFPROP MIN (LAMBDA $N
(PROG ($V)
(SETQ $V (ARG $N))
A (SETQ $N (SUB1 $N))
(COND ((ZEROP $N)(RETURN $V))
((LESSP (ARG $N) $V) (SETQ $V (ARG $N))))
(GO A)))EXPR)
(DEFPROP MAX (LAMBDA $N
(PROG ($V)
(SETQ $V (ARG $N))
A (SETQ $N (SUB1 $N))
(COND ((ZEROP $N)(RETURN $V))
((GREATERP (ARG $N) $V)(SETQ $V (ARG $N))))
(GO A)))EXPR)
(DEFPROP MEMQ (LAMBDA ($E $L)
(COND ((NULL $L) NIL)
((NOT (ATOM (CAR $L)))(MEMQ $E (CDR $L)))
((EQ $E (CAR $L)) $L)
(T (MEMQ $E (CDR $L)))))EXPR)
(DEFPROP MEMBER (LAMBDA ($E $L)
(COND ((NULL $L) NIL)
((EQUAL $E (CAR $L)) $L)
(T (MEMBER $E (CDR $L)))))EXPR)
(DEFPROP RANDOM (LAMBDA ()
(QUOTIENT (TIMES (EXAMINE 15)(EXAMINE 16) ) (MAX (EXAMINE 15)(EXAMINE 16)))
)EXPR)
(DEFPROP AND (LAMBDA ($L)
(AND# (CDR $L))) MACRO)
(DEFPROP AND# (LAMBDA ($L)
(COND ((NULL (CDR $L))(LIST (QUOTE COND)(LIST (CAR $L))))
(T (LIST (QUOTE COND)(LIST (CAR $L)(AND# (CDR $L)))))))EXPR)
(DEFPROP OR (LAMBDA ($L)
(OR# (CDR $L)))
MACRO)
(DEFPROP OR# (LAMBDA ($L)
(APPEND (QUOTE (COND))(MAPCAR (FUNCTION LIST) $L)))
EXPR)
(PUTPROP @AND @(LAMBDA ($L)
(AND# (CDR $L))) @MACRO)
(PUTPROP @OR @(LAMBDA ($L)
(OR# (CDR $L)))
@MACRO)
(DEFPROP MAPCAR (LAMBDA $L
(COND ((GREATERP $L 3)(PRINT @(MAPCAR OF 3 ARG LISTS))(ERR))
((EQUAL $L 2)(MAPCAR# (ARG 1)(ARG 2)))
(T (COND ((OR (NULL (ARG 2))(NULL (ARG 3)))NIL)
(T (CONS ((ARG 1)(CAR (ARG 2))(CAR (ARG 3)))
(MAPCAR (ARG 1)(CDR (ARG 2))(CDR (ARG 3)))))))))EXPR)
(DEFPROP MAPC (LAMBDA $L
(COND ((GREATERP $L 4)(PRINT @(MAPC OF FOUR ARG LISTS))(ERR))
((EQUAL $L 2)(MAPC# (ARG 1)(ARG 2)) (ARG 2) )
((EQUAL $L 3)
(PROG ($A $B)
(SETQ $A (ARG 2))(SETQ $B (ARG 3))
L1 (AND (OR (NULL $A)(NULL $B))(RETURN (ARG 2)) )
((ARG 1)(CAR $A)(CAR $B))
(SETQ $A (CDR $A))(SETQ $B (CDR $B))
(GO L1 )))
(T (PROG ($A $B $C) (SETQ $A (ARG 2))(SETQ $B (ARG 3))(SETQ $C(ARG 4))
L1 (AND (OR (NULL $A)(NULL $B)(NULL $C))(RETURN (ARG 2)))
((ARG 1)(CAR $A)(CAR $B)(CAR $C))
(SETQ $A(CDR $A))(SETQ $B (CDR $B))(SETQ $C(CDR $C))
(GO L1)))))EXPR)
(DECLARE (SPECIAL $R $F $L))
(DEFPROP MAPCAN
(LAMBDA($F $L)
(PROG ($R)
(MAPC(FUNCTION (LAMBDA($X)(SETQ $R(NCONC $R ($F $X)))))$L)
(RETURN $R)))
EXPR)
(DECLARE (UNSPECIAL $R $F $L))
(DEFPROP APPLY
(LAMBDA $L
(COND ((GETL (ARG 1) (QUOTE (EXPR LSUBR SUBR)))
(APPLY# (ARG 1)(ARG 2)))
((EVAL (CONS (ARG 1)(ARG 2))))))
EXPR)
(DM PP ($L) (LIST @GRINDEF (EVAL (CADR $L))))
(DF CATCH ($N) (EVAL (CAR $N)))
(DF THROW ($N) (EVAL (CAR $N)))
(PUTPROP @/= (GET @EQUAL @SUBR) @SUBR)
(PUTPROP @/< (GET @*LESS @SUBR) @SUBR)
(PUTPROP @/> (GET @*GREAT @SUBR) @SUBR)
(PUTPROP @/+ (GET @*PLUS @SUBR) @SUBR)
(PUTPROP @/1+ (GET @ADD1 @SUBR) @SUBR)
(PUTPROP @/1- (GET @SUB1 @SUBR) @SUBR)
(PUTPROP @/- (GET @*DIF @SUBR) @SUBR)
(DF MAKREADTABLE (L) (APPEND @(MAKREADTABLE) L))
(DF SSTATUS (L) (APPEND @(SSTATUS) L))
(DF GLOBAL (L) (APPEND @(GLOBAL) L))
(DF FUNCTIONS (L) (APPEND @(FUNCTIONS) L))
(DE BOUNDP (L) (GET L @VALUE))
(PUTPROP @*SQ (GET @SETQ @FSUBR) @FSUBR)
(DF SETQ ($#%L)
(PROG ($#%X)
A (COND ((NULL $#%L)(RETURN $#%X)))
(*SQ $#%X (SET (EVAL @(CAR $#%L))(EVAL (CADR $#%L)) ))
(*SQ $#%L (CDDR $#%L))
(GO A)))
(PUTPROP @*GT (GET @GET @SUBR) @SUBR)
(DE GET ($X $I)(COND ((NUMBERP $X)NIL)(T(*GT $X $I))))